home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Sep / di9809nu / RegistU.pas < prev   
Pascal/Delphi Source File  |  1998-06-25  |  4KB  |  174 lines
  1. unit RegistU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, StdCtrls, Buttons, ExtCtrls, AdDial, AdModem, AdWnPort, OoMisc,
  8.   AdPort, AdSocket, AdProtcl, AdTapi;
  9.  
  10. type
  11.   string40 = string[40];
  12.  
  13.   TForm1 = class(TForm)
  14.     PageControl1: TPageControl;
  15.     InformationSheet: TTabSheet;
  16.     SendSheet: TTabSheet;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     Label3: TLabel;
  20.     Label4: TLabel;
  21.     edName: TEdit;
  22.     edSerialNumber: TEdit;
  23.     edE_Mail: TEdit;
  24.     btnCancel1: TBitBtn;
  25.     btnNext: TBitBtn;
  26.     rdgSendRegInfo: TRadioGroup;
  27.     btnFinish: TBitBtn;
  28.     btnCancel2: TBitBtn;
  29.     ApdComPort1: TApdComPort;
  30.     ApdWinsockPort1: TApdWinsockPort;
  31.     ApdProtocol1: TApdProtocol;
  32.     ApdTapiDevice1: TApdTapiDevice;
  33.     procedure btnCancel2Click(Sender: TObject);
  34.     procedure btnCancel1Click(Sender: TObject);
  35.     procedure btnNextClick(Sender: TObject);
  36.     procedure btnFinishClick(Sender: TObject);
  37.     procedure InformationSheetExit(Sender: TObject);
  38.     procedure PageControl1Changing(Sender: TObject;
  39.       var AllowChange: Boolean);
  40.     procedure ApdTapiDevice1TapiConnect(Sender: TObject);
  41.   private
  42.     { Private declarations }
  43.     { local variables to hold registration data }
  44.     FName : string40;
  45.     FSerialNumber : string40;
  46.     FE_Mail : string40;
  47.     RegStringList : TStringList;
  48.     function SendViaInternet: boolean;
  49.     function SendViaPhoneLine: boolean;
  50.   public
  51.     { Public declarations }
  52.     TempFileName : string;
  53.     TempFile : textfile;
  54.   end;
  55.  
  56. var
  57.   Form1: TForm1;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. function TForm1.SendViaInternet:  boolean;
  64. var
  65.   MyPort : Integer;
  66.   ApdSocket : TApdSocket;
  67. begin
  68.   result := false;
  69. ApdSocket := TApdSocket.Create(Application);
  70. with ApdSocket do
  71. try
  72.   if not ApdWinsockPort1.Open then
  73.     begin
  74.       ApdWinsockPort1.WsAddress := 'bbs.turbopower.com';
  75.       ApdWinsockPort1.WsPort := 'telnet';
  76.       Result := true;
  77.     end
  78. finally
  79.   Free;
  80.   end;
  81.   ApdProtocol1.FileMask := FName;
  82.   ApdProtocol1.StartTransmit;
  83. end;
  84.  
  85. function TForm1.SendViaPhoneLine: boolean;
  86. begin
  87.   ApdTapiDevice1.Dial('p1-718-260-9726');
  88.  // ApdProtocol1.FileMask := FName;
  89.  // ApdProtocol1.StartTransmit;
  90. end;
  91.  
  92. procedure TForm1.btnCancel2Click(Sender: TObject);
  93. begin
  94.   Close;
  95. end;
  96.  
  97. procedure TForm1.btnCancel1Click(Sender: TObject);
  98. begin
  99.   Close;
  100. end;
  101.  
  102. procedure TForm1.btnNextClick(Sender: TObject);
  103. begin
  104.   If edName.text = '' then
  105.     begin
  106.       MessageDlg('You must enter your name before sending '+
  107.                  'registration information', mtError, [mbOK], 0);
  108.       Exit;
  109.     end;
  110.     if edSerialNumber.Text = '' then
  111.       begin
  112.         MessageDlg('You must enter your serial number before sending '+
  113.                    'registration information', mtError, [mbOK], 0);
  114.         Exit;
  115.       end;
  116.  // ApdTapiDevice1.ConfigAndOpen;
  117.   PageControl1.ActivePage := SendSheet;
  118. end;
  119.  
  120. procedure TForm1.btnFinishClick(Sender: TObject);
  121. begin
  122.   if rdgSendRegInfo.ItemIndex=-1 then
  123.      begin
  124.         MessageDlg('You need to indicate how to send the information',
  125.         mtError, [mbOK], 0);
  126.         Exit;
  127.      end
  128.   else
  129.     case rdgSendRegInfo.ItemIndex of    //
  130.       0: SendViaPhoneLine;
  131.       1: SendViaInternet;
  132.     end;    // case
  133.   MessageDlg('Registration information succesfully sent.  Thankyou',
  134.         mtConfirmation, [mbOK], 0);
  135.   Close;
  136. end;
  137.  
  138. procedure TForm1.InformationSheetExit(Sender: TObject);
  139. begin
  140.   FName := edName.Text;
  141.   FSerialNumber := edSerialNumber.TEXT;
  142.   FE_Mail := edE_Mail.Text;
  143. end;
  144.  
  145. procedure TForm1.PageControl1Changing(Sender: TObject;
  146.   var AllowChange: Boolean);
  147. begin
  148.   AllowChange := ((FName <> '')AND(FSerialNumber <> ''));
  149.   if AllowChange then
  150.     begin
  151.       TempFileName := 'C:\WINDOWS\TEMP\REG_INFO.TXT';
  152.       try
  153.         AssignFile(TempFile, TempFileName);
  154.         Rewrite(TempFile);
  155.         Writeln(TempFile, FName);
  156.         Writeln(TempFile, FSerialNumber);
  157.         Writeln(TempFile, FE_Mail);
  158.         CloseFile(TempFile);
  159.        except
  160.          MessageDlg('Registration file could not be created; closing...',
  161.            mtError, [mbOK], 0);
  162.          Halt;
  163.        end;
  164.       end;
  165. end;
  166.  
  167. procedure TForm1.ApdTapiDevice1TapiConnect(Sender: TObject);
  168. begin
  169.   ApdProtocol1.FileMask := FName;
  170.   ApdProtocol1.StartTransmit;
  171. end;
  172.  
  173. end.
  174.